Attribute VB_Name = "Module1"
Option Explicit

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Public m_objPlaylists As New Collection

Public m_nMaxRunningCount As Long
Public m_sFFmpeg As String
Public m_nDefaultCombineType As Long

Public Sub LoadConfig(ByVal fn As String)
On Error Resume Next
Dim s As String, s1 As String
Dim lps As Long
'///
m_nMaxRunningCount = 1
m_sFFmpeg = vbNullString
m_nDefaultCombineType = 0
'///
Err.Clear
Open fn For Input As #1
If Err.Number = 0 Then
 Set m_objPlaylists = New Collection
 Do Until EOF(1)
  Line Input #1, s
  s = Trim(Replace(s, vbTab, " "))
  If s = vbNullString Or Left(s, 1) = "#" Then
  Else
   lps = InStr(1, s, "=")
   If lps > 0 Then
    s1 = Trim(Left(s, lps - 1))
    s = Trim(Mid(s, lps + 1))
    Select Case s1
    Case "MaxRunningCount"
     m_nMaxRunningCount = Val(s)
    Case "ffmpeg"
     m_sFFmpeg = s
    Case "CombineType"
     m_nDefaultCombineType = Val(s)
    End Select
   End If
  End If
 Loop
End If
Close
End Sub

Public Sub SaveConfig(ByVal fn As String)
On Error GoTo a
Dim v As Variant
Open fn For Output As #1
Print #1, "MaxRunningCount=" + CStr(m_nMaxRunningCount)
Print #1, "ffmpeg=" + m_sFFmpeg
Print #1, "CombineType=" + CStr(m_nDefaultCombineType)
a:
Close
End Sub

Public Sub LoadPlaylists(ByVal fn As String)
On Error Resume Next
Dim s As String, s1 As String
Dim lps As Long
'///
Err.Clear
Open fn For Input As #1
If Err.Number = 0 Then
 Set m_objPlaylists = New Collection
 Do Until EOF(1)
  Line Input #1, s
  s = Trim(Replace(s, vbTab, " "))
  If s = vbNullString Or Left(s, 1) = "#" Then
  Else
   lps = InStr(1, s, " ")
   If lps > 0 Then s1 = Left(s, lps - 1) Else s1 = s
   s1 = StringToHex(s1)
   m_objPlaylists.Remove s1
   m_objPlaylists.Add s, s1
  End If
 Loop
End If
Close
End Sub

Public Sub SavePlaylists(ByVal fn As String)
On Error GoTo a
Dim v As Variant
Open fn For Output As #1
For Each v In m_objPlaylists
 Print #1, CStr(v)
Next v
a:
Close
End Sub

'workaround for stupid VB collection :-3
Public Function StringToHex(ByVal s As String) As String
Dim i As Long
For i = 1 To Len(s)
 StringToHex = StringToHex + Right("000" + Hex(AscW(Mid(s, i, 1)) And &HFFFF&), 4)
Next i
End Function

Public Function UTF8EncodeB(ByRef rstrUnicode As String, ByRef iUtf() As Byte) As Long
  Dim iData() As Integer, lLen As Long, n As Long, i As Long, strUtf As String
  Erase iUtf
  lLen = Len(rstrUnicode)
  If lLen = 0 Then Exit Function
  ReDim iData(lLen - 1)
  ReDim iUtf(lLen * 3 - 1)
  CopyMemory iData(0), ByVal StrPtr(rstrUnicode), lLen * 2
  For n = 0 To lLen - 1
    If (iData(n) And &HFF80) = 0 Then 'iData(n) < &H80 And Not iData(n) < 0 Then
      iUtf(i) = iData(n)
      i = i + 1
    ElseIf (iData(n) And &HF800) = 0 Then 'iData(n) < &H800 And Not iData(n) < 0 Then
      iUtf(i) = &HFF And (&HC0 Or (iData(n) \ &H40&))
      i = i + 1
      iUtf(i) = &HFF And (&H80 Or (iData(n) And &H3F))
      i = i + 1
    Else
      iUtf(i) = &HFF And (&HE0 Or ((iData(n) And &HFFFF&) \ &H1000&))
      i = i + 1
      iUtf(i) = &HFF And (&H80 Or (((iData(n) And &HFFFF&) \ &H40&) And &H3F))
      i = i + 1
      iUtf(i) = &HFF And (&H80 Or (iData(n) And &H3F))
      i = i + 1
    End If
  Next
  If i > 0 Then ReDim Preserve iUtf(i - 1) Else Erase iUtf
  UTF8EncodeB = i
End Function

Public Function UTF8DecodeByteArray(ByRef iUtf() As Byte) As String
  Dim iUnicode() As Integer, n As Long, i As Long, strUnicode As String, lLen As Long
  Dim j As Long
  
  lLen = UBound(iUtf) + 1
  If lLen <= 0 Then Exit Function
  ReDim iUnicode(lLen - 1)
  
  On Error GoTo catch   ' catch index out of range errors caused by illegal utf sequences
  
  For n = 0 To lLen - 1
    If iUtf(n) > &HEF& Then
      GoTo catch
    ElseIf (iUtf(n) And &HF0&) = &HE0& Then   ' 3 byte seq.
      If (iUtf(n + 1) And &HC0&) <> &H80& Or (iUtf(n + 2) And &HC0&) <> &H80& Then GoTo catch
      j = (((iUtf(n) And &HF&) * &H1000&) Or ((iUtf(n + 1) And &H3F&) * &H40&) Or (iUtf(n + 2) And &H3F&))
      If j And &H8000& Then j = j Or &HFFFF0000
      iUnicode(i) = j
      i = i + 1
      n = n + 2
    ElseIf (iUtf(n) And &HE0&) = &HC0& Then   ' 2 byte seq.
      If (iUtf(n + 1) And &HC0&) <> &H80& Then GoTo catch
      iUnicode(i) = (((iUtf(n) And &H1F&) * &H40&) Or (iUtf(n + 1) And &H3F&))
      i = i + 1
      n = n + 1
    Else   ' 1 byte char
      iUnicode(i) = iUtf(n)
      i = i + 1
    End If
  Next
catch:
  If i > 0 Then
    strUnicode = Space$(i)
    CopyMemory ByVal StrPtr(strUnicode), iUnicode(0), i * 2
  End If
  UTF8DecodeByteArray = strUnicode
End Function

